﻿/***  File Header  ************************************************************/
/**
* @file DicBasic.cpp
*
* P4th 基本ワード
* @author	shozo fukuda
* @date		作成 Fri Oct 14 10:40:26 2005
* @date		修正 $Date: 06/04/19 9:23 $
* System	Generic <br>
*
*******************************************************************************/

/*******************************************************************************
* IMPORTS:
*******************************************************************************/
#include <string.h>
#include "Dic.h"	/* 呼出用 */

/*******************************************************************************
* CONSTANT:
*******************************************************************************/

/*******************************************************************************
* TYPE:
*******************************************************************************/

/*******************************************************************************
* MACRO:
*******************************************************************************/

/*******************************************************************************
* GLOBAL VARIABLE:
*******************************************************************************/

/***  Module Header  ******************************************************}}}*/
/**
* FORTH補助ワード (UNKNOWN)
* @par 解説
*   未定義ワードの処理をコールします。
*
* @par forth SUBR f_unknown IMMEDIATE
**/
/**************************************************************************{{{*/
void f_unknown(
P4th* p4th)
{
	p4th->Unknown();
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTH補助ワード (LIT)
* @par 解説
*   コードに埋め込まれた数値をデータスタックに積みます。
*
* @par forth SUBR f_lit
**/
/**************************************************************************{{{*/
void f_lit(
P4th* p4th)
{
	Magic val;
	val.C[0] = CODE(IP++);
	val.C[1] = CODE(IP++);
	PUSH(val.D);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード :
* @par 解説
*   ユーザー・ワードの定義を開始します。このワードに引き続く入力文字列がユーザー
*   ワードの名前となります。
*
* @par forth CODE : f_colon END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_colon(
P4th* p4th)
{
	p4th->Colon();
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTH実行ルーチン DOCOL
* @par 解説
*   :で定義されたユーザー・ワードの実行ルーチンです。現在の命令ポインタIPをリター
*		ンスタックRSにプッシュし、このワードのパラメタ・フィールドのコードを実行する
*   ようにIPを設定します。
*
* @par forth CFUNC f_docol
**/
/**************************************************************************{{{*/
void f_docol(
P4th* p4th)
{
	RPUSH(IP);
	IP = W;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード ;
* @par 解説
*   :で始まるユーザー・ワードの定義を完了させます。
*
* @par forth CODE ; f_semicolon END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_semicolon(
P4th* p4th)
{
	BUILD(P_EXIT);
	STATE = COMP_FINISH;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード IMMEDIATE
* @par 解説
*   現在のCURRENTが指すワード(最近定義したワード)にIMMEDIATE属性を付加します。
*   IMMEDIATE属性を持つワードは、コンパイル・モードであっても即時実行されます。
*
* @par forth CODE IMMEDIATE f_immediate END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_immediate(
P4th* p4th)
{
	CODE(W2CFA(CURRENT)) |= F_IMMEDIATE;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード CONSTANT
* @par 解説
*   ユーザー定数の定義を開始します。このワードに引き続く入力文字列がユーザー定数
*   の名前となります。
*
* @par forth CODE CONSTANT f_constant END-CODE
**/
/**************************************************************************{{{*/
void f_constant(
P4th* p4th)
{
	p4th->Constant();
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTH実行ルーチン DOCONST
* @par 解説
*   CONSTANTで定義されたユーザー定数の実行ルーチンです。インタプリタ・モードでは
*   対応する定数値をスタックSPにプッシュします。一方、コンパイル・モードではコー
*   ド・メモリに対応する定数値をスタックSPにプッシュするコードを生成します。
*
* @par forth CFUNC f_doconst END-CODE
**/
/**************************************************************************{{{*/
void f_doconst(
P4th* p4th)
{
	p4th->DoConst();
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード VARIABLE
* @par 解説
*   ユーザー変数の定義を開始します。このワードに引き続く入力文字列がユーザー変数
*   の名前となります。
*
* @par forth CODE VARIABLE f_variable END-CODE
**/
/**************************************************************************{{{*/
void f_variable(
P4th* p4th)
{
	p4th->Variable();
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTH実行ルーチン DOVAR
* @par 解説
*   VARIABLEで定義されたユーザー変数の実行ルーチンです。インタプリタ・モードでは
*   対応する変数のインデックスをスタックSPにプッシュします。一方、コンパイル・
*   モードではコード・メモリに対応する変数のインデックスをスタックSPにプッシュす
*   るコードを生成します。
*
* @par forth CFUNC f_dovar END-CODE
**/
/**************************************************************************{{{*/
void f_dovar(
P4th* p4th)
{
	p4th->DoVar();
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード DUP ( n -- n n )
* @par 解説
*   TOSを複製し、スタックにプッシュします。
*
* @par forth CODE DUP f_dup END-CODE
**/
/**************************************************************************{{{*/
void f_dup(
P4th* p4th)
{
	long val = TOS;
	PUSH(val);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード ?DUP ( n -- n n )
* @par 解説
*   TOSが 0以外ならば複製し、スタックにプッシュします。
*
* @par forth CODE ?DUP f_qdup END-CODE
**/
/**************************************************************************{{{*/
void f_qdup(
P4th* p4th)
{
	long val = TOS;
	if (TOS != 0) {
		PUSH(val);
	}
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード DROP ( n -- )
* @par 解説
*   TOSをスタックから削除します。
*
* @par forth CODE DROP f_drop END-CODE
**/
/**************************************************************************{{{*/
void f_drop(
P4th* p4th)
{
	POP();
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード SWAP ( n2 n1 -- n1 n2 )
* @par 解説
*   TOSとS2を入れ替えます。
*
* @par forth CODE SWAP f_swap END-CODE
**/
/**************************************************************************{{{*/
void f_swap(
P4th* p4th)
{
	p4th->Roll(2);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード OVER ( n2 n1 -- n2 n1 n2 )
* @par 解説
*   S2を複製し、スタックにプッシュします。
*
* @par forth CODE OVER f_over END-CODE
**/
/**************************************************************************{{{*/
void f_over(
P4th* p4th)
{
	long val = S2;
	PUSH(val);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード ROT ( n3 n2 n1 -- 
* @par 解説
*   TOS,S2,S3の順序を入れ替えます。
*
* @par forth CODE ROT f_rot END-CODE
**/
/**************************************************************************{{{*/
void f_rot(
P4th* p4th)
{
	p4th->Roll(3);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード PICK ( n1 -- n ) 
* @par 解説
*   TOSをインデックスとして、スタックトップからインデックス分下のデータを読み出
*   しスタックに積みます。
*
* @par forth CODE PICK f_pick END-CODE
**/
/**************************************************************************{{{*/
void f_pick(
P4th* p4th)
{
	long index = POP();
	long val   = S(index);
	PUSH(val);
}


/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード 2DUP ( n2 n1 -- n2 n1 n2 n1 )
* @par 解説
*   組[TOS,S2]を複製し、スタックにプッシュします。
*
* @par forth CODE 2DUP f_2dup END-CODE
**/
/**************************************************************************{{{*/
void f_2dup(
P4th* p4th)
{
	long val;
	
	val = S2;
	PUSH(val);
	val = S2;
	PUSH(val);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード 2DROP ( n2 n1 -- )
* @par 解説
*   組[TOS,S2]をスタックから削除します。
*
* @par forth CODE 2DROP f_2drop END-CODE
**/
/**************************************************************************{{{*/
void f_2drop(
P4th* p4th)
{
	POP();
	POP();
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード 2OVER ( n4 n3 n2 n1 -- n4 n3 n2 n1 n4 n3 )
* @par 解説
*   組[S3,S4]を複製し、スタックにプッシュします。
*
* @par forth CODE 2OVER f_2over END-CODE
**/
/**************************************************************************{{{*/
void f_2over(
P4th* p4th)
{
	long val;
	
	val = S4;
	PUSH(val);
	val = S4;
	PUSH(val);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード 2SWAP ( 
* @par 解説
*   組[TOS,S2]と組[S3,S4]を入れ替えます。
*
* @par forth CODE 2SWAP f_2swap END-CODE
**/
/**************************************************************************{{{*/
void f_2swap(
P4th* p4th)
{
	long tmp;

	tmp = TOS;  TOS = S3;  S3  = tmp;
	tmp = S2;   S2  = S4;  S4  = tmp;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード DEPTH ( -- n )
* @par 解説
*   スタックの深さをスタックにプッシュします。
*
* @par forth CODE DEPTH f_depth END-CODE
**/
/**************************************************************************{{{*/
void f_depth(
P4th* p4th)
{
	long val = DEPTH;
	PUSH(val);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード . ( n -- )
* @par 解説
*   スタックトップのデータを印字します。
*
* @par forth CODE . f_dot END-CODE
**/
/**************************************************************************{{{*/
void f_dot(
P4th* p4th)
{
	long val = POP();
	p4th->Printf("%ld ", val);	
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード EMIT ( n -- )
* @par 解説
*   TOSをポップし、その値を文字コードとして出力デバイスに1文字印字します。
*
* @par forth CODE EMIT f_emit END-CODE
**/
/**************************************************************************{{{*/
void f_emit(
P4th* p4th)
{
	long val = POP();
	p4th->PutC((char)val);	
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード SPACE ( -- )
* @par 解説
*   出力デバイスに空白文字を1文字印字します。
*
* @par forth CODE SPACE f_space END-CODE
**/
/**************************************************************************{{{*/
void f_space(
P4th* p4th)
{
	p4th->PutC(' ');	
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード SPACES ( n -- )
* @par 解説
*   出力デバイスに空白文字をTOSの数の個数分印字します。
*
* @par forth CODE SPACES f_spaces END-CODE
**/
/**************************************************************************{{{*/
void f_spaces(
P4th* p4th)
{
	long count = POP();

	while (count-- > 0) {
		p4th->PutC(' ');
	}
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード CR ( -- )
* @par 解説
*   出力デバイスに改行文字を印字します。
*
* @par forth CODE CR f_cr END-CODE
**/
/**************************************************************************{{{*/
void f_cr(
P4th* p4th)
{
	p4th->PutC('\n');
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード .2HEX ( n -- )
* @par 解説
*   TOSをスタックからポップし、その下位 8ビットを16進数2桁で表示します。
*
* @par forth CODE .2HEX f_dot_2hex END-CODE
**/
/**************************************************************************{{{*/
void f_dot_2hex(
P4th* p4th)
{
	long val = POP();
	p4th->Printf("%02X ", val & 0xFF);	
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード .4HEX ( n -- )
* @par 解説
*   TOSをスタックからポップし、その下位 16ビットを16進数4桁で表示します。
*
* @par forth CODE .4HEX f_dot_4hex END-CODE
**/
/**************************************************************************{{{*/
void f_dot_4hex(
P4th* p4th)
{
	long val = POP();
	p4th->Printf("%04X ", val & 0xFFFF);	
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード .8HEX ( n -- )
* @par 解説
*   TOSをスタックからポップし、16進数8桁で表示します。
*
* @par forth CODE .8HEX f_dot_8hex END-CODE
**/
/**************************************************************************{{{*/
void f_dot_8hex(
P4th* p4th)
{
	long val = POP();
	p4th->Printf("%08X ", val);	
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード @ ( addr -- n' )
* @par 解説
*   TOSで示されるアドレスに格納されているデータをスタックに積みます。
*
* @par forth CODE @ f_fetch END-CODE
**/
/**************************************************************************{{{*/
void f_fetch(
P4th* p4th)
{
	Magic val;
	long  loc = POP();

	val.C[0] = CODE(loc);
	val.C[1] = CODE(loc+1);
	PUSH(val.D);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード ! ( data addr -- )
* @par 解説
*   TOSで示されるアドレスにS2のデータを格納します。
*
* @par forth CODE ! f_store END-CODE
**/
/**************************************************************************{{{*/
void f_store(
P4th* p4th)
{
	Magic val;
	long  loc = POP();

	val.D = POP();
	CODE(loc)   = val.C[0]; 
	CODE(loc+1) = val.C[1];
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード +! ( n loc -- )
* @par 解説
*   loc
*
* @par forth CODE +! f_plus_store END-CODE
**/
/**************************************************************************{{{*/
void f_plus_store(
P4th* p4th)
{
	Magic val;
	long  loc = POP();

	val.C[0] = CODE(loc);
	val.C[1] = CODE(loc+1);

	val.D += POP();

	CODE(loc)   = val.C[0]; 
	CODE(loc+1) = val.C[1];
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード C@ ( addr -- n' )
* @par 解説
*   TOSで示されるアドレスに格納されているバイトデータをスタックにプッシュします。
*
* @par forth CODE C@ f_c_fetch END-CODE
**/
/**************************************************************************{{{*/
void f_c_fetch(
P4th* p4th)
{
	Magic val;
	long  loc = POP();

	val.C[0] = CODE(loc);
	val.C[1] = CODE(loc+1);
	PUSH(val.D);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード C! ( data addr -- )
* @par 解説
*   TOSで示されるアドレスにS2のデータをバイトデータとして格納します。
*
* @par forth CODE C! f_c_store END-CODE
**/
/**************************************************************************{{{*/
void f_c_store(
P4th* p4th)
{
	char* ptr = (char*)POP();
	*ptr = POP();
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード +	( n2 n1 -- n )
* @par 解説
*   TOSとS2をスタックからポップし、(S2 + TOS)をスタックにプッシュします。
*
* @par forth CODE + f_add END-CODE
**/
/**************************************************************************{{{*/
void f_add(
P4th* p4th)
{
	long val = POP();
	TOS += val;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード -	( n2 n1 -- n )
* @par 解説
*   TOSとS2をスタックからポップし、(S2 - TOS)をスタックにプッシュします。
*
* @par forth CODE - f_sub END-CODE
**/
/**************************************************************************{{{*/
void f_sub(
P4th* p4th)
{
	long val = POP();
	TOS -= val;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード *	( n2 n1 -- n )
* @par 解説
*   TOSとS2をスタックからポップし、(S2 * TOS)をスタックにプッシュします。
*
* @par forth CODE * f_mul END-CODE
**/
/**************************************************************************{{{*/
void f_mul(
P4th* p4th)
{
	long val = POP();
	TOS *= val;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード /	( n2 n1 -- n )
* @par 解説
*   TOSとS2をスタックからポップし、(long)(S2 / TOS)をスタックにプッシュします。
*
* @par forth CODE / f_div END-CODE
**/
/**************************************************************************{{{*/
void f_div(
P4th* p4th)
{
	long val = POP();
	TOS /= val;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード MOD	( n2 n1 -- n )
* @par 解説
*   TOSとS2をスタックからポップし、(S2 % TOS)をスタックにプッシュします。
*
* @par forth CODE MOD f_mod END-CODE
**/
/**************************************************************************{{{*/
void f_mod(
P4th* p4th)
{
	long val = POP();
	TOS %= val;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード 1+ ( n1 -- n )
* @par 解説
*   TOSに 1を加えます。
*
* @par forth CODE 1+ f_incr END-CODE
**/
/**************************************************************************{{{*/
void f_incr(
P4th* p4th)
{
	TOS++;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード 1- ( n1 -- n )
* @par 解説
*   TOSから 1を引きます。
*
* @par forth CODE 1- f_decr END-CODE
**/
/**************************************************************************{{{*/
void f_decr(
P4th* p4th)
{
	TOS--;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード NEGATE ( n1 -- n )
* @par 解説
*   TOSの符号を反転します。
*
* @par forth CODE NEGATE f_negate END-CODE
**/
/**************************************************************************{{{*/
void f_negate(
P4th* p4th)
{
	TOS = -TOS;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード ABS ( n1 -- n )
* @par 解説
*   TOSを絶対値に変換します。
*
* @par forth CODE ABS f_abs END-CODE
**/
/**************************************************************************{{{*/
void f_abs(
P4th* p4th)
{
	if (TOS < 0) {
		TOS = -TOS;
	}
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード MIN ( n2 n1 -- n )
* @par 解説
*   TOSとS2をスタックからポップし、min(S2,TOS)をスタックにプッシュします。
*
* @par forth CODE MIN f_min END-CODE
**/
/**************************************************************************{{{*/
void f_min(
P4th* p4th)
{
	long a, b;
	a = POP();
	b = POP();
	PUSH((a < b) ? a : b);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード MAX ( n2 n1 -- n )
* @par 解説
*   TOSとS2をスタックからポップし、max(S2,TOS)をスタックにプッシュします。
*
* @par forth CODE MAX f_max END-CODE
**/
/**************************************************************************{{{*/
void f_max(
P4th* p4th)
{
	long a, b;
	a = POP();
	b = POP();
	PUSH((a > b) ? a : b);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード AND ( n2 n1 -- n )
* @par 解説
*   TOSとS2をスタックからポップし、(S2 & TOS)をスタックにプッシュします。
*
* @par forth CODE AND f_and END-CODE
**/
/**************************************************************************{{{*/
void f_and(
P4th* p4th)
{
	long val = POP();
	TOS &= val;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード OR ( n2 n1 -- n )
* @par 解説
*   TOSとS2をスタックからポップし、(S2 | TOS)をスタックにプッシュします。
*
* @par forth CODE OR f_or END-CODE
**/
/**************************************************************************{{{*/
void f_or(
P4th* p4th)
{
	long val = POP();
	TOS |= val;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード XOR ( n2 n1 -- n )
* @par 解説
*   TOSとS2をスタックからポップし、(S2 ^ TOS)をスタックにプッシュします。
*
* @par forth CODE XOR f_xor END-CODE
**/
/**************************************************************************{{{*/
void f_xor(
P4th* p4th)
{
	long val = POP();
	TOS ^= val;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード = ( n2 n1 -- f )
* @par 解説
*   TOSとS2をスタックからポップし、(S2 == TOS)をスタックにプッシュします。
*
* @par forth CODE = f_eq END-CODE
**/
/**************************************************************************{{{*/
void f_eq(
P4th* p4th)
{
	long val = POP();
	TOS = (TOS == val);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード < ( n2 n1 -- f )
* @par 解説
*   TOSとS2をスタックからポップし、(S2 < TOS)をスタックにプッシュします。
*
* @par forth CODE < f_lt END-CODE
**/
/**************************************************************************{{{*/
void f_lt(
P4th* p4th)
{
	long val = POP();
	TOS = (TOS < val);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード > ( n2 n1 -- f )
* @par 解説
*   TOSとS2をスタックからポップし、(S2 > TOS)をスタックにプッシュします。
*
* @par forth CODE > f_gt END-CODE
**/
/**************************************************************************{{{*/
void f_gt(
P4th* p4th)
{
	long val = POP();
	TOS = (TOS > val);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード 0= ( n -- f )
* @par 解説
*   TOSをスタックからポップし、(TOS == 0)をスタックにプッシュします。
*
* @par forth CODE 0= f_zeq END-CODE
**/
/**************************************************************************{{{*/
void f_zeq(
P4th* p4th)
{
	TOS = (TOS == 0);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード 0< ( n -- f )
* @par 解説
*   TOSをスタックからポップし、(TOS < 0)をスタックにプッシュします。
*
* @par forth CODE 0< f_zlt END-CODE
**/
/**************************************************************************{{{*/
void f_zlt(
P4th* p4th)
{
	TOS = (TOS < 0);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード 0> ( n -- f )
* @par 解説
*   TOSをスタックからポップし、(TOS > 0)をスタックにプッシュします。
*
* @par forth CODE 0> f_zgt END-CODE
**/
/**************************************************************************{{{*/
void f_zgt(
P4th* p4th)
{
	TOS = (TOS > 0);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード >R ( n -- )
* @par 解説
*   TOSをスタックからポップし、リターンスタックにプッシュします。
*
* @par forth CODE >R f_to_r END-CODE
**/
/**************************************************************************{{{*/
void f_to_r(
P4th* p4th)
{
	long val = POP();
	RPUSH(val);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード R> ( -- n )
* @par 解説
*   RTOSをリターンスタックからポップし、スタックにプッシュします。
*
* @par forth CODE R> f_from_r END-CODE
**/
/**************************************************************************{{{*/
void f_from_r(
P4th* p4th)
{
	long val = RPOP();
	PUSH(val);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード R@ ( -- n )
* @par 解説
*   RTOSをスタックにプッシュします。リターンスタックは不変です。
*
* @par forth CODE R@ f_r_fetch END-CODE
**/
/**************************************************************************{{{*/
void f_r_fetch(
P4th* p4th)
{
	PUSH(RTOS);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTH補助ワード (0BRANCH) ( n -- )
* @par 解説
*   TOSをスタックからポップし、その値が 0ならばオペランドが示すコード・インデック
*   スにジャンプします。そうでなければ、オペランドを読み飛ばし次のコードに進みます。
*
* @par forth SUBR f_0branch
**/
/**************************************************************************{{{*/
void f_0branch(
P4th* p4th)
{
	long val = POP();
	
	IP += (val == 0) ? (short)CODE(IP) : 1;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTH補助ワード (BRANCH)
* @par 解説
*   オペランドが示すコード・インデックスに無条件にジャンプします。
*
* @par forth SUBR f_branch
**/
/**************************************************************************{{{*/
void f_branch(
P4th* p4th)
{
	IP += (short)CODE(IP);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード IF ( f -- )
* @par 解説
*   制御構造 IF … [ELSE …] THEN
*
* @par forth CODE IF f_if END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_if(
P4th* p4th)
{
	BEG_SELF;

	BUILD(P_0BRANCH);
	HERE();
	BUILD(0);		// 0BRANCEのオペランド。ワードELSE或いはTHENがジャンプ先を確定する。
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード ELSE ( -- )
* @par 解説
*   (1)分岐先を仮置きしたBRANCHを生成します。
*   (2)IFの仮置きの分岐先を確定します。
*
* @par forth CODE ELSE f_else END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_else(
P4th* p4th)
{
	long loc = POP();

	BUILD(P_BRANCH);
	HERE();
	BUILD(0);	

	CODE(loc) = OFFS(loc);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード THEN ( -- )
* @par 解説
*   IFまたはELSEの仮置きの分岐先を確定します。
*
* @par forth CODE THEN f_then END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_then(
P4th* p4th)
{
	long loc = POP();

	CODE(loc) = OFFS(loc);

	END_SELF;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード BEGIN ( -- )
* @par 解説
*   DO実行ルーチンをコードの現在位置に埋め込みます。
*
* @par forth CODE BEGIN f_begin END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_begin(
P4th* p4th)
{
	BEG_SELF;

	HERE();
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード UNTIL ( f -- )
* @par 解説
*   UNTIL実行ルーチンをコードの現在位置に埋め込みます。
*
* @par forth CODE UNTIL f_until END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_until(
P4th* p4th)
{
	long loc = POP();

	BUILD(P_0BRANCH);
	BUILD(-OFFS(loc));
	
	END_SELF;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード WHILE ( f -- )
* @par 解説
*   WHILE実行ルーチンをコードの現在位置に埋め込みます。
*
* @par forth CODE WHILE f_while END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_while(
P4th* p4th)
{
	BUILD(P_0BRANCH);
	HERE();
	BUILD(0);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード REPEAT ( -- )
* @par 解説
*   REPEAT実行ルーチンをコードの現在位置に埋め込みます。
*
* @par forth CODE REPEAT f_repeat END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_repeat(
P4th* p4th)
{
	long loc2 = POP();
	long loc1 = POP();

	BUILD(P_BRANCH);
	BUILD(-OFFS(loc1));

	CODE(loc2) = OFFS(loc2);
	
	END_SELF;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード DO ( n2 n1 -- )
* @par 解説
*   DO実行ルーチンをコードの現在位置に埋め込みます。
*
* @par forth CODE DO f_do END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_do(
P4th* p4th)
{
	BEG_SELF;

	HERE();
	BUILD(P_XDO);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード DOの実行時ルーチン
* @par 解説
*   DO実行ルーチンです。TOS,S2をポップし、リターンスタックに積みます。
*
* @par forth SUBR f_xdo
**/
/**************************************************************************{{{*/
void f_xdo(
P4th* p4th)
{
	long beg, end;
	
	beg = POP();
	end = POP();

	RPUSH(end);
	RPUSH(beg);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード LOOP ( -- )
* @par 解説
*   LOOP実行ルーチンをコードの現在位置に埋め込みます。
*
* @par forth CODE LOOP f_loop END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_loop(
P4th* p4th)
{
	long loc = POP();

	BUILD(P_XLOOP);

	switch (CODE(loc++)) {
	case P_XDO:
		BUILD(-OFFS(loc));
		break;
	default:
		break;
	}
	
	END_SELF;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード LOOPの実行時ルーチン
* @par 解説
*   LOOP実行ルーチンです。リターンスタックに積まれている制御変数をテストし、
*   ループの繰り返しを制御します。
*
* @par forth SUBR f_xloop
**/
/**************************************************************************{{{*/
void f_xloop(
P4th* p4th)
{
	if (++RTOS < R2) {
		IP += (short)CODE(IP);

	} else {
		RPOP();
		RPOP();
		IP++;
	}
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード +LOOP ( n -- )
* @par 解説
*   +LOOP実行ルーチンをコードの現在位置に埋め込みます。
*
* @par forth CODE +LOOP f_ploop END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_ploop(
P4th* p4th)
{
	long loc = POP();

	BUILD(P_XPLOOP);

	switch (CODE(loc++)) {
	case P_XDO:
		BUILD(-OFFS(loc));
		break;
	default:
		break;
	}

	END_SELF;
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード +LOOPの実行時ルーチン
* @par 解説
*   DO-LOOP制御カウンタにTOSを加え、その値が上限値を超えていなければ対応する
*   DOワードまで制御を戻します。制御カウンタの値が上限値以上であればループを終了
*   します。
*
* @par forth SUBR f_xploop
**/
/**************************************************************************{{{*/
void f_xploop(
P4th* p4th)
{
	long val = POP();
	
	RTOS += val;
	if (RTOS < R2) {
		IP += (short)CODE(IP);

	} else {
		RPOP();
		RPOP();
		IP++;
	}
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード I ( -- n )
* @par 解説
*   DO … LOOPの中で用い、そのループのインデックスの現在値をスタックに置きます。
*
* @par forth CODE I f_i END-CODE
**/
/**************************************************************************{{{*/
void f_i(
P4th* p4th)
{
	long val = RTOS;
	PUSH(val);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード J ( -- n )
* @par 解説
*   DO … LOOPの中で用い、そのループのインデックスの現在値をスタックに置きます。
*
* @par forth CODE J f_j END-CODE
**/
/**************************************************************************{{{*/
void f_j(
P4th* p4th)
{
	long val = R3;
	PUSH(val);
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード EXIT ( -- )
* @par 解説
*   ワードの実行からリターンします。
*
* @par forth CODE EXIT f_exit END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_exit(
P4th* p4th)
{
	IP = RPOP();
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード VERSION ( -- )
* @par 解説
*   出力デバイスにP4thのバージョンを印字します。
*
* @par forth CODE VERSION f_version END-CODE
**/
/**************************************************************************{{{*/
void f_version(
P4th* p4th)
{
	p4th->Version();
}

/***  Module Header  ******************************************************}}}*/
/**
* FORTHワード DUMP ( -- )
* @par 解説
*   登録済みワードのリストを印字します。
*
* @par forth CODE DUMP f_dumpnew END-CODE IMMEDIATE
**/
/**************************************************************************{{{*/
void f_dumpnew(
P4th* p4th)
{
	p4th->DumpNew();
}

/* end of DicBasic.cpp */

